home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 02 - 1986 / 02.09 Sep 86.sit / 02.09 Sep 86 / forth source / Structures Text next >
Encoding:
Text File  |  1986-06-28  |  2.8 KB  |  118 lines  |  [TEXT/MACA]
  1.  
  2. ( Structures, Mach-1 version                  
  3. ----------
  4. Adding a structure compiler to Forth. JL 26.6.86.
  5. This file defines a Pascal-like 'record' structure;
  6. a record is a template for instances of the structure.
  7.  
  8. Example
  9.  
  10. :record a
  11.     >long field1
  12.     >word field2
  13. ;record
  14.  
  15. myrec r1 \this creates an instance r1 of myrec whose fields
  16.           may be accessed through myrec ^ field1 etc..
  17.  
  18. for 'late binding' usage, the word ^field is provided)
  19.  
  20. only forth also assembler
  21. decimal
  22. ( some MacForth definitions that Mach1 is missing )
  23. : =cells dup 2 mod + ;
  24. : needed depth 1- > abort" NEEDED- not enough stack items" ;
  25.  
  26. CODE =string 
  27.       count rot count rot swap  
  28.       MOVE.W    #0,-(A7)
  29.       MOVE.L    $C(A6),-(A7)
  30.       MOVE.L    $8(A6),-(A7)
  31.       MOVE.W    $6(A6),-(A7)
  32.       MOVE.W    $2(A6),-(A7)
  33.       MOVE.W    #12,-(A7)
  34.       _pack6 
  35.       ADDQ.L    #8,A6
  36.       ADDQ.L    #8,A6
  37.       MOVE.W    (A7)+,-(A6)
  38.       MOVE.W    #0,-(A6)
  39.       RTS
  40. END-CODE
  41.  
  42. CODE -string 
  43.       count rot count swap  
  44.       MOVE.L    (A6)+,A0
  45.       MOVE.L    (A6)+,D0
  46.       SWAP.W    D0
  47.       MOVE.L    (A6)+,D1
  48.       MOVE.W    D1,D0   
  49.       MOVE.L    (A6)+,A1
  50.       _cmpstring
  51.       MOVE.L    D0,-(A6)
  52.       RTS
  53. END-CODE
  54.  
  55. ( do.record, creating one instance of a record )  ( 062686 jl )
  56. : do.record  ( addr of master | -- )
  57.     create  dup ,
  58.         begin dup c@ dup while ( not zero, i.e. end)
  59.             1+ =cells 4 + + ( next field in template )
  60.         repeat
  61.     drop 2+ w@ ( length stored here ) allot
  62.     does>  ( nothing special )
  63. ;
  64.  
  65. ( :record ;record and friends)                    ( 062686 jl )
  66.  
  67. :  :record  create 13579 4 does> do.record ;
  68.  
  69. :  ;record  2 needed
  70.     0 w, ( end of list) w, ( total length )
  71.     13579 = 0= abort" ;record without :record"
  72. ;
  73.  
  74. :  put.fieldname
  75.     32 word here over c@ 1+ dup =cells allot cmove ;
  76.  
  77.  
  78. ( field defining words )                          ( 062686 jl )
  79. : >long ( addr | addr+4)
  80.         put.fieldname dup w, 4 w, 4 + ;
  81. : >word ( addr | addr+2)
  82.         put.fieldname dup w, 2 w, 2+ ;
  83. : >byte ( addr | addr+1)
  84.         put.fieldname dup w, 1 w, 1+ ;
  85. : >bytes ( addr \ n | addr+n )
  86.         put.fieldname over w, dup w, + ;
  87.  
  88. ( ^field, addressing a field within a record )    ( 062686 jl )
  89. : ^field ( addr name | address of field )
  90.     over @ ( addr name master )
  91.         begin 2dup -string while ( no match )
  92.             dup c@ 6 + =cells +
  93.             dup c@ 0= ( end of list )
  94.                 abort" RECORD- specified field does not exist"
  95.         repeat
  96.     ( match found )
  97.     dup c@ 1+ =cells + w@ ( start within record )
  98.     swap drop   +  ( address of field )
  99. ;
  100.  
  101. ( ^ )                                   ( 062686 jl )
  102.  
  103. : ^   32 word ^field ;
  104.  
  105.  
  106. ( example of a record structure )                 ( 062686 jl )
  107.  
  108. :record testrec
  109.     >long date
  110.     >long time
  111.     >byte flag
  112.     >word counts
  113.  30 >bytes description
  114. ;record
  115.  
  116. testrec r1
  117. testrec r2
  118.